home *** CD-ROM | disk | FTP | other *** search
/ Aminet 52 / Aminet 52 (2002)(GTI - Schatztruhe)[!][Dec 2002].iso / Aminet / dev / gg / ncurses-5.3.lha / ncurses-5.3 / Ada95 / samples / sample-menu_demo.adb < prev    next >
Text File  |  2002-10-24  |  15KB  |  392 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                       GNAT ncurses Binding Samples                       --
  4. --                                                                          --
  5. --                              Sample.Menu_Demo                            --
  6. --                                                                          --
  7. --                                 B O D Y                                  --
  8. --                                                                          --
  9. ------------------------------------------------------------------------------
  10. -- Copyright (c) 1998 Free Software Foundation, Inc.                        --
  11. --                                                                          --
  12. -- Permission is hereby granted, free of charge, to any person obtaining a  --
  13. -- copy of this software and associated documentation files (the            --
  14. -- "Software"), to deal in the Software without restriction, including      --
  15. -- without limitation the rights to use, copy, modify, merge, publish,      --
  16. -- distribute, distribute with modifications, sublicense, and/or sell       --
  17. -- copies of the Software, and to permit persons to whom the Software is    --
  18. -- furnished to do so, subject to the following conditions:                 --
  19. --                                                                          --
  20. -- The above copyright notice and this permission notice shall be included  --
  21. -- in all copies or substantial portions of the Software.                   --
  22. --                                                                          --
  23. -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
  24. -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
  25. -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
  26. -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
  27. -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
  28. -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
  29. -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
  30. --                                                                          --
  31. -- Except as contained in this notice, the name(s) of the above copyright   --
  32. -- holders shall not be used in advertising or otherwise to promote the     --
  33. -- sale, use or other dealings in this Software without prior written       --
  34. -- authorization.                                                           --
  35. ------------------------------------------------------------------------------
  36. --  Author:  Juergen Pfeifer, 1996
  37. --  Contact: http://www.familiepfeifer.de/Contact.aspx?Lang=en
  38. --  Version Control
  39. --  $Revision: 1.12 $
  40. --  Binding Version 01.00
  41. ------------------------------------------------------------------------------
  42. with Terminal_Interface.Curses; use Terminal_Interface.Curses;
  43. with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels;
  44. with Terminal_Interface.Curses.Menus; use Terminal_Interface.Curses.Menus;
  45. with Terminal_Interface.Curses.Menus.Menu_User_Data;
  46. with Terminal_Interface.Curses.Menus.Item_User_Data;
  47.  
  48. with Sample.Manifest; use Sample.Manifest;
  49. with Sample.Function_Key_Setting; use Sample.Function_Key_Setting;
  50. with Sample.Menu_Demo.Handler;
  51. with Sample.Helpers; use Sample.Helpers;
  52. with Sample.Explanation; use Sample.Explanation;
  53.  
  54. package body Sample.Menu_Demo is
  55.  
  56.    package Spacing_Demo is
  57.       procedure Spacing_Test;
  58.    end Spacing_Demo;
  59.  
  60.    package body Spacing_Demo is
  61.  
  62.       procedure Spacing_Test
  63.       is
  64.          function My_Driver (M : Menu;
  65.                              K : Key_Code;
  66.                              P : Panel) return Boolean;
  67.  
  68.          procedure Set_Option_Key;
  69.          procedure Set_Select_Key;
  70.          procedure Set_Description_Key;
  71.          procedure Set_Hide_Key;
  72.  
  73.          package Mh is new Sample.Menu_Demo.Handler (My_Driver);
  74.  
  75.          I : Item_Array_Access := new Item_Array'
  76.            (New_Item ("January",   "31 Days"),
  77.             New_Item ("February",  "28/29 Days"),
  78.             New_Item ("March",     "31 Days"),
  79.             New_Item ("April",     "30 Days"),
  80.             New_Item ("May",       "31 Days"),
  81.             New_Item ("June",      "30 Days"),
  82.             New_Item ("July",      "31 Days"),
  83.             New_Item ("August",    "31 Days"),
  84.             New_Item ("September", "30 Days"),
  85.             New_Item ("October",   "31 Days"),
  86.             New_Item ("November",  "30 Days"),
  87.             New_Item ("December",  "31 Days"),
  88.             Null_Item);
  89.  
  90.          M : Menu   := New_Menu (I);
  91.          Flip_State : Boolean := True;
  92.          Hide_Long  : Boolean := False;
  93.  
  94.          type Format_Code is (Four_By_1, Four_By_2, Four_By_3);
  95.          type Operations  is (Flip, Reorder, Reformat, Reselect, Describe);
  96.  
  97.          type Change is array (Operations) of Boolean;
  98.          pragma Pack (Change);
  99.          No_Change : constant Change := Change'(others => False);
  100.  
  101.          Current_Format : Format_Code := Four_By_1;
  102.          To_Change : Change := No_Change;
  103.  
  104.          function My_Driver (M : Menu;
  105.                              K : Key_Code;
  106.                              P : Panel) return Boolean
  107.          is
  108.          begin
  109.             To_Change := No_Change;
  110.             if K in User_Key_Code'Range then
  111.                if K = QUIT then
  112.                   return True;
  113.                end if;
  114.             end if;
  115.             if K in Special_Key_Code'Range then
  116.                case K is
  117.                   when Key_F4 =>
  118.                      To_Change (Flip) := True;
  119.                      return True;
  120.                   when Key_F5 =>
  121.                      To_Change (Reformat)  := True;
  122.                      Current_Format := Four_By_1;
  123.                      return True;
  124.                   when Key_F6 =>
  125.                      To_Change (Reformat)  := True;
  126.                      Current_Format := Four_By_2;
  127.                      return True;
  128.                   when Key_F7 =>
  129.                      To_Change (Reformat)  := True;
  130.                      Current_Format := Four_By_3;
  131.                      return True;
  132.                   when Key_F8 =>
  133.                      To_Change (Reorder) := True;
  134.                      return True;
  135.                   when Key_F9 =>
  136.                      To_Change (Reselect) := True;
  137.                      return True;
  138.                   when Key_F10 =>
  139.                      if Current_Format /= Four_By_3 then
  140.                         To_Change (Describe) := True;
  141.                         return True;
  142.                      else
  143.                         return False;
  144.                      end if;
  145.                   when Key_F11 =>
  146.                      Hide_Long := not Hide_Long;
  147.                      declare
  148.                         O : Item_Option_Set;
  149.                      begin
  150.                         for J in I'Range loop
  151.                            Get_Options (I (J), O);
  152.                            O.Selectable := True;
  153.                            if Hide_Long then
  154.                               case J is
  155.                                  when 1 | 3 | 5 | 7 | 8 | 10 | 12 =>
  156.                                     O.Selectable := False;
  157.                                  when others => null;
  158.                               end case;
  159.                            end if;
  160.                            Set_Options (I (J), O);
  161.                         end loop;
  162.                      end;
  163.                      return False;
  164.                   when others => null;
  165.                end case;
  166.             end if;
  167.             return False;
  168.          end My_Driver;
  169.  
  170.          procedure Set_Option_Key
  171.          is
  172.             O : Menu_Option_Set;
  173.          begin
  174.             if Current_Format = Four_By_1 then
  175.                Set_Soft_Label_Key (8, "");
  176.             else
  177.                Get_Options (M, O);
  178.                if O.Row_Major_Order then
  179.                   Set_Soft_Label_Key (8, "O-Col");
  180.                else
  181.                   Set_Soft_Label_Key (8, "O-Row");
  182.                end if;
  183.             end if;
  184.             Refresh_Soft_Label_Keys_Without_Update;
  185.          end Set_Option_Key;
  186.  
  187.          procedure Set_Select_Key
  188.          is
  189.             O : Menu_Option_Set;
  190.          begin
  191.             Get_Options (M, O);
  192.             if O.One_Valued then
  193.                Set_Soft_Label_Key (9, "Multi");
  194.             else
  195.                Set_Soft_Label_Key (9, "Singl");
  196.             end if;
  197.             Refresh_Soft_Label_Keys_Without_Update;
  198.          end Set_Select_Key;
  199.  
  200.          procedure Set_Description_Key
  201.          is
  202.             O : Menu_Option_Set;
  203.          begin
  204.             if Current_Format = Four_By_3 then
  205.                Set_Soft_Label_Key (10, "");
  206.             else
  207.                Get_Options (M, O);
  208.                if O.Show_Descriptions then
  209.                   Set_Soft_Label_Key (10, "-Desc");
  210.                else
  211.                   Set_Soft_Label_Key (10, "+Desc");
  212.                end if;
  213.             end if;
  214.             Refresh_Soft_Label_Keys_Without_Update;
  215.          end Set_Description_Key;
  216.  
  217.          procedure Set_Hide_Key
  218.          is
  219.          begin
  220.             if Hide_Long then
  221.                Set_Soft_Label_Key (11, "Enab");
  222.             else
  223.                Set_Soft_Label_Key (11, "Disab");
  224.             end if;
  225.             Refresh_Soft_Label_Keys_Without_Update;
  226.          end Set_Hide_Key;
  227.  
  228.       begin
  229.          Push_Environment ("MENU01");
  230.          Notepad ("MENU-PAD01");
  231.          Default_Labels;
  232.          Set_Soft_Label_Key (4, "Flip");
  233.          Set_Soft_Label_Key (5, "4x1");
  234.          Set_Soft_Label_Key (6, "4x2");
  235.          Set_Soft_Label_Key (7, "4x3");
  236.          Set_Option_Key;
  237.          Set_Select_Key;
  238.          Set_Description_Key;
  239.          Set_Hide_Key;
  240.  
  241.          Set_Format (M, 4, 1);
  242.          loop
  243.             Mh.Drive_Me (M);
  244.             exit when To_Change = No_Change;
  245.             if To_Change (Flip) then
  246.                if Flip_State then
  247.                   Flip_State := False;
  248.                   Set_Spacing (M, 3, 2, 0);
  249.                else
  250.                   Flip_State := True;
  251.                   Set_Spacing (M);
  252.                end if;
  253.             elsif To_Change (Reformat) then
  254.                case Current_Format is
  255.                   when Four_By_1 => Set_Format (M, 4, 1);
  256.                   when Four_By_2 => Set_Format (M, 4, 2);
  257.                   when Four_By_3 =>
  258.                      declare
  259.                         O : Menu_Option_Set;
  260.                      begin
  261.                         Get_Options (M, O);
  262.                         O.Show_Descriptions := False;
  263.                         Set_Options (M, O);
  264.                         Set_Format (M, 4, 3);
  265.                      end;
  266.                end case;
  267.                Set_Option_Key;
  268.                Set_Description_Key;
  269.             elsif To_Change (Reorder) then
  270.                declare
  271.                   O : Menu_Option_Set;
  272.                begin
  273.                   Get_Options (M, O);
  274.                   O.Row_Major_Order := not O.Row_Major_Order;
  275.                   Set_Options (M, O);
  276.                   Set_Option_Key;
  277.                end;
  278.             elsif To_Change (Reselect) then
  279.                declare
  280.                   O : Menu_Option_Set;
  281.                begin
  282.                   Get_Options (M, O);
  283.                   O.One_Valued := not O.One_Valued;
  284.                   Set_Options (M, O);
  285.                   Set_Select_Key;
  286.                end;
  287.             elsif To_Change (Describe) then
  288.                declare
  289.                   O : Menu_Option_Set;
  290.                begin
  291.                   Get_Options (M, O);
  292.                   O.Show_Descriptions := not O.Show_Descriptions;
  293.                   Set_Options (M, O);
  294.                   Set_Description_Key;
  295.                end;
  296.             else
  297.                null;
  298.             end if;
  299.          end loop;
  300.          Set_Spacing (M);
  301.          Flip_State := True;
  302.  
  303.          Pop_Environment;
  304.          pragma Assert (Get_Index (Items (M, 1)) = Get_Index (I (1)));
  305.          Delete (M);
  306.          Free (I, True);
  307.       end Spacing_Test;
  308.    end Spacing_Demo;
  309.  
  310.    procedure Demo
  311.    is
  312.       --  We use this datatype only to test the instantiation of
  313.       --  the Menu_User_Data generic package. No functionality
  314.       --  behind it.
  315.       type User_Data is new Integer;
  316.       type User_Data_Access is access User_Data;
  317.  
  318.       --  Those packages are only instantiated to test the usability.
  319.       --  No real functionality is shown in the demo.
  320.       package MUD is new Menu_User_Data (User_Data, User_Data_Access);
  321.       package IUD is new Item_User_Data (User_Data, User_Data_Access);
  322.  
  323.       function My_Driver (M : Menu;
  324.                           K : Key_Code;
  325.                           P : Panel) return Boolean;
  326.  
  327.       package Mh is new Sample.Menu_Demo.Handler (My_Driver);
  328.  
  329.       Itm : Item_Array_Access := new Item_Array'
  330.         (New_Item ("Menu Layout Options"),
  331.          New_Item ("Demo of Hook functions"),
  332.          Null_Item);
  333.       M : Menu := New_Menu (Itm);
  334.  
  335.       U1 : User_Data_Access := new User_Data'(4711);
  336.       U2 : User_Data_Access;
  337.       U3 : User_Data_Access := new User_Data'(4712);
  338.       U4 : User_Data_Access;
  339.  
  340.       function My_Driver (M : Menu;
  341.                           K : Key_Code;
  342.                           P : Panel) return Boolean
  343.       is
  344.          Idx   : constant Positive := Get_Index (Current (M));
  345.       begin
  346.          if K in User_Key_Code'Range then
  347.             if K = QUIT then
  348.                return True;
  349.             elsif K = SELECT_ITEM then
  350.                if Idx in Itm'Range then
  351.                   Hide (P);
  352.                   Update_Panels;
  353.                end if;
  354.                case Idx is
  355.                   when 1 => Spacing_Demo.Spacing_Test;
  356.                   when others => Not_Implemented;
  357.                end case;
  358.                if Idx in Itm'Range then
  359.                   Top (P);
  360.                   Show (P);
  361.                   Update_Panels;
  362.                   Update_Screen;
  363.                end if;
  364.             end if;
  365.          end if;
  366.          return False;
  367.       end My_Driver;
  368.    begin
  369.       Push_Environment ("MENU00");
  370.       Notepad ("MENU-PAD00");
  371.       Default_Labels;
  372.       Refresh_Soft_Label_Keys_Without_Update;
  373.       Set_Pad_Character (M, '|');
  374.  
  375.       MUD.Set_User_Data (M, U1);
  376.       IUD.Set_User_Data (Itm (1), U3);
  377.  
  378.       Mh.Drive_Me (M);
  379.  
  380.       MUD.Get_User_Data (M, U2);
  381.       pragma Assert (U1 = U2 and U1.all = 4711);
  382.  
  383.       IUD.Get_User_Data (Itm (1), U4);
  384.       pragma Assert (U3 = U4 and U3.all = 4712);
  385.  
  386.       Pop_Environment;
  387.       Delete (M);
  388.       Free (Itm, True);
  389.    end Demo;
  390.  
  391. end Sample.Menu_Demo;
  392.